home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / ip / dns / dnsparse-2.0 / dnsparse.pl < prev    next >
Encoding:
Perl Script  |  1990-09-11  |  6.4 KB  |  255 lines
  1. #!/usr/bin/perl
  2. #
  3. # $Id: dnsparse.pl,v 2.0 90/09/11 11:07:36 hakanson Rel $
  4. #
  5. # Subroutines to parse DNS master (RFC-1035) format files.
  6. #   Marion Hakanson (hakanson@cse.ogi.edu)
  7. #   Oregon Graduate Institute of Science and Technology
  8. #
  9. # Copyright (c) 1990, Marion Hakanson.
  10. #
  11. # You may distribute under the terms of the GNU General Public License
  12. # as specified in the README file that comes with the dnsparse kit.
  13. #
  14. # Note that this file is not standalone.  It requires the dnslex C program,
  15. # and it provides subroutines for a calling Perl program.
  16. #
  17. # One calls dns_init() with a list of input master file names, each
  18. # optionally with an origin domain following it after a comma.  The
  19. # typical calling program might pass those from its @ARGV, something
  20. # like "dnstest zone.x,x.edu zone.y.x,y.x.edu".
  21. #
  22. # Then the calling program repeatedly calls dns_getrr() until it returns
  23. # the null array, at which point all the input files are exhausted.  Some
  24. # type checking is done, and some minor canonicalization is done (e.g. the
  25. # RR types are capitalized and domain names lower-cased), but more of both
  26. # should be added to catch errors.
  27. #
  28. # Apologies for the ugly code.  It was originally designed to take only
  29. # a single input file per invocation, and should really be reworked to
  30. # deal with multiple files more gracefully.
  31.  
  32. package dns;
  33.  
  34. $FALSE = 0;
  35. $TRUE  = 1;
  36.  
  37. $prog = $main'0;
  38. $prog =~ s?^.*/??;
  39.  
  40. # Defaults
  41. $dnslex = 'dnslex';
  42. $delim  = ':';
  43.  
  44. # Package globals
  45. $initialized = $FALSE;
  46. $fileopen    = $FALSE;
  47. $alldone     = $FALSE;
  48. $pid         = 0;
  49.  
  50.  
  51. sub main'dns_init {
  52.     if ( $#_ < $[ ) {
  53.         @dns_argv = (',');
  54.     } else {
  55.         @dns_argv = @_;
  56.     }
  57.     $initialized = $TRUE;
  58. }
  59.  
  60.  
  61. sub main'dns_getrr {
  62.     local (@data);
  63.     local ($tmp,$data);
  64.     local ($ttl,$class,$type);
  65.  
  66.  die "$prog: dns_init() not called, aborted" unless ($initialized);
  67.  
  68.  #print STDERR "inside dns_getrr()\n";
  69.  while (1) {
  70.   #print STDERR "inside outer-while\n";
  71.   tryopen: until ( $fileopen || $alldone ) {
  72.     #print STDERR "inside tryopen\n";
  73.     if ( $#dns_argv < $[ ) {
  74.       $alldone = $TRUE;
  75.       next tryopen;
  76.     }
  77.  
  78.     ($ifile,$origin1) = do main'dns_commasplit(shift(@dns_argv));
  79.  
  80.     if ( $ifile eq '' || $ifile eq '-' ) {
  81.         $ifile = '';
  82.         @dns_argv = ();    # STDIN must be last
  83.     } else {
  84.         unless ( -r $ifile ) {
  85.             print STDERR "$prog: $ifile: $!, trying another\n";
  86.         next tryopen;
  87.     }
  88.     $ifile = "< $ifile";
  89.     }
  90.  
  91.     $pid = open(DNS_IN, "$dnslex -d$delim $ifile |");
  92.     unless ( defined($pid) ) {
  93.         print STDERR "$prog: Can't start '$dnslex $ifile', trying another\n";
  94.         next tryopen;
  95.     }
  96.     $origin = do main'dns_makefqdn($origin1, '');    # '' is root
  97.     $domain = $origin;
  98.     $fileopen = $TRUE;
  99.   }
  100.  
  101.   #print STDERR "tryopen() done\n";
  102.   return () unless ( $fileopen );
  103.   #print STDERR "fileopen test passed\n";
  104.  
  105.   dline: while ( <DNS_IN> ) {
  106.             #print STDERR $_;
  107.     chop;
  108.     @data = split(/$delim/o);        # split on $delim
  109.             #print STDERR "$data[0] $data[1] $data[2]\n";
  110.     s/$delim/ /go;            # for error msgs
  111.     
  112.     if ( $data[0] =~ /^\$/ ) {        # special "$" directives
  113.     if ( $data[0] =~ /^\$ORIGIN$/i
  114.         && $data[1] ) {
  115.         $origin = do main'dns_makefqdn($data[1], $origin);
  116.     } else {
  117.         print STDERR "$prog: unknown directive ignored: $_\n";
  118.     }
  119.     next dline;
  120.     }
  121.  
  122.     # Set $domain for the current record.  After doing so,
  123.     # $data[0] should contain the next field to parse.
  124.  
  125.     dom: {
  126.     if ( $data[0] eq "." ) {    # root domain
  127.         $domain = "";
  128.         last dom;
  129.     }
  130.     if ( $data[0] eq "@" ) {    # use $origin
  131.         $domain = $origin;
  132.         last dom;
  133.     }
  134.     if ( $data[0] ne "" ) {
  135.         $domain = do main'dns_makefqdn($data[0], $origin);
  136.         last dom;
  137.     }
  138.     # otherwise use current domain
  139.     }
  140.     shift(@data);
  141.  
  142.     if ( $data[0] =~ /^[0-9]+/ ) {    # numeric ttl
  143.     $ttl = shift(@data);
  144.     } else {
  145.     $ttl = 0;            # default
  146.     }
  147.  
  148.     # This defaulting looks strange, but it's what named does
  149.     if ( $data[0] =~ /IN/i ||
  150.      $data[0] =~ /CHAOS/i ) {
  151.     $class = shift(@data);
  152.     $class =~ tr/a-z/A-Z/;
  153.     } else {
  154.     $class = "IN";
  155.     }
  156.  
  157.     $type = shift(@data);
  158.     $type =~ tr/a-z/A-Z/;
  159.     typ: {
  160.     if ( $type eq "A" ||
  161.          $type eq "WKS" ||
  162.          $type eq "HINFO" ||
  163.          $type eq "UID" ||
  164.          $type eq "GID" ) {
  165.         last typ;            # no further processing
  166.     }
  167.     if ( $type eq "SOA" ||
  168.          $type eq "MINFO" ) {
  169.         $data[0] = do main'dns_makefqdn($data[0], $origin);
  170.         $data[1] = do main'dns_makefqdn($data[1], $origin);
  171.         last typ;
  172.     }
  173.     if ( $type eq "NS" ||
  174.          $type eq "CNAME" ||
  175.          $type eq "MB" ||
  176.          $type eq "MG" ||
  177.          $type eq "MR" ||
  178.          $type eq "PTR" ) {
  179.         $data[0] = do main'dns_makefqdn($data[0], $origin);
  180.         last typ;
  181.     }
  182.     if ( $type eq "MX" ) {
  183.         if ( $data[0] !~ /^[0-9]/ || $data[0] > 64535 ) {
  184.         print STDERR "$prog: bad MX ignored: $_\n";
  185.         next dline;
  186.         }
  187.         $data[1] = do main'dns_makefqdn($data[1], $origin);
  188.         last typ;
  189.     }
  190.     if ( $type eq "UINFO" ) {
  191.         # need to check for escaped dot here !!!
  192.         ($tmp) = split(/./,$domain,1);
  193.         $data[0] =~ s/&/$tmp/e;
  194.         last typ;
  195.     }
  196.     # otherwise
  197.     print STDERR "$prog: unrecognized type '$type' ignored: $_\n";
  198.     next dline;
  199.     }
  200.     return ($domain,$ttl,$class,$type,@data);
  201.   }
  202.   close(DNS_IN);
  203.   $fileopen = $FALSE;
  204.   # now we've hit eof & must open the next file
  205.   # to satisfy the getrr() request.
  206.  }  
  207. }
  208.  
  209.  
  210.  
  211.  
  212. sub main'dns_makefqdn {
  213.     local ($name, $origin) = @_;
  214.     
  215.     return ("") if ( $name eq "." ||    # root domain
  216.              $name eq "" );    # should not happen
  217.     # check for non-escaped trailing dot
  218.     if ( $name =~ /(.*)(\\*)\.$/
  219.         && (length($2) % 2 == 0) ) {
  220.     return ($1.$2);            # strip trailing dot
  221.     }
  222.     $origin =~ s/^\.//;            # strip leading dot
  223.     return ($name) if ( $origin eq "" );
  224.     return ($origin) if ( $name eq "@" );
  225.     return ("$name.$origin");
  226. }
  227.  
  228.  
  229. # The file args may be of the form 'file,domain', where ',' is
  230. # the first un-doubled comma (later commas are not processed).
  231.  
  232. sub main'dns_commasplit {
  233.     local ($_) = @_;
  234.     local ($first,$secnd);
  235.  
  236.     $first = '';
  237.     $secnd = '';
  238.     
  239.     commasplit: while ( /,/ ) {
  240.         $first .= $`;    # before the comma
  241.         $_ = $';    # and after it
  242.  
  243.         if ( s/^,// ) {    # turn double into a single & continue
  244.             $first .= ',';
  245.         } else {    # make the split
  246.             $secnd = $_;
  247.             $_ = '';    # remainder goes above
  248.             last commasplit;
  249.         }
  250.     }
  251.     $first .= $_;    # in case no single comma was found
  252.     ($first,$secnd);
  253. }
  254.  
  255.